home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbnws201.zip / Z.BAS < prev   
BASIC Source File  |  1991-01-08  |  19KB  |  342 lines
  1. REM Z.BAS Copyright 1990
  2. REM by Charles Graham, POB 58634, St. Louis, MO 63158
  3. '                                                      
  4. 'Z.BAS is an elementary communications program written in
  5. 'Microsoft QuickBASIC 4.5.  It opens the computer's console
  6. '(CON) as a file and funnels all screen writes through CON.
  7. 'If a user has ANSI.SYS installed properly, this technique
  8. 'makes Z.BAS compatible with Bulletin Board Systems that use
  9. 'ANSI escape sequences to produce color and animation on their
  10. 'user's screens.                                           
  11. '                                                      
  12. 'There are only a few requirements for running Z.BAS:  
  13. '   1)  use an IBM-compatible computer with at least   
  14. '       128K of available RAM                          
  15. '   2)  use a Hayes-compatible modem                   
  16. '   3)  use a color monitor and video board            
  17. '   4)  call a BBS using modem parameters of N,8,1 (no 
  18. '       parity, 8 data bits, 1 stop bit) unless you want
  19. '       to change the code in SUB getparms             
  20. '   5)  install ANSI.SYS if not already installed.     
  21. '
  22. DECLARE SUB bottomline ()                   'Prints line 25
  23. DECLARE SUB delay ()                        'Wastes time
  24. DECLARE SUB getparms ()                     'You need these
  25. DECLARE SUB hangup ()                       'Byebye, BBS
  26. DECLARE SUB initialize ()                   'Foreplay
  27. DECLARE SUB makeacall ()                    'Reach out & touch
  28. DECLARE SUB opencomport ()                  'Open Sesame
  29. DECLARE SUB outtahere ()                    'I quit!
  30.                                             '
  31. DIM SHARED ao$                              'Lots of SUBs
  32. DIM SHARED cs$                              ' need these so
  33. DIM SHARED bp$                              ' SHARE
  34. DIM SHARED comport$                         '
  35. DIM SHARED comspec$                         '
  36. DIM SHARED es$                              '
  37. DIM SHARED dialmode$                        '
  38. DIM SHARED firsttime$                       '
  39. DIM SHARED init$                            '
  40. DIM SHARED hc$                              '
  41. ON ERROR GOTO errorroutine                  'Just in case
  42. DEFINT A-Z                                  'Speeds things up
  43. es$ = CHR$(27)                              'ESCape
  44. ao$ = es$ + "[0m"                           'Attributes off
  45. cs$ = es$ + "[2J"                           'Clear screen
  46. f1$ = CHR$(0) + CHR$(59)                    'F1 key
  47. f10$ = CHR$(0) + CHR$(68)                   'F10 key
  48. ff$ = CHR$(12)                              'Form feed
  49. hc$ = es$ + "[f"                            'Home cursor
  50. OPEN "con" FOR OUTPUT AS 2                  'Console as file
  51. CALL initialize                             'Foreplay
  52. PRINT #2, ao$;                              'Attributes off
  53. PRINT #2, cs$ + " " + hc$;                  'Home cursor
  54. CALL getparms                               'You need these
  55. CALL opencomport                            'Open Sesame
  56. CALL bottomline                             'Print line 25
  57. DO                                          'Begin endless loop
  58.     a$ = INKEY$                             'Check keyboard
  59.     IF a$ <> "" THEN                        'Key pressed?
  60.         SELECT CASE a$                      'What do I do now?
  61.             CASE es$                        'ESCape key?
  62.                 CALL hangup                 ' Byebye, BBS
  63.             CASE f1$                        'F1 key?
  64.                 CALL makeacall              ' Reach out & touch
  65.             CASE f10$                       'F10 key?
  66.                 CALL outtahere              ' I quit!
  67.             CASE ELSE                       'Some other key?
  68.                 PRINT #1, a$;               ' Send it to modem
  69.         END SELECT                          '
  70.     END IF                                  '
  71.     WHILE NOT EOF(1)                        'Characters arrived?
  72.         b$ = INPUT$(LOC(1), #1)             'Receive characters
  73.         WHILE INSTR(b$, ff$) <> 0           'If an ASCII form
  74.             q = INSTR(b$, ff$)              ' feed is received
  75.             b$ = LEFT$(b$, q - 1) + cs$ + MID$(b$, q + 1)
  76.                                             ' change it to ANSI
  77.         WEND                                '
  78.         PRINT #2, b$;                       'Print characters
  79.         a$ = INKEY$                         'Check keyboard
  80.         IF a$ <> "" THEN                    'Key pressed?
  81.             SELECT CASE a$                  'What do I do now?
  82.                 CASE es$                    'ESCape key?
  83.                     CALL hangup             ' Byebye, BBS
  84.                 CASE f1$                    'F1 key?
  85.                     CALL makeacall          ' Reach out & touch
  86.                 CASE f10$                   'F10 key?
  87.                     CALL outtahere          ' I quit!
  88.                 CASE ELSE                   'Some other key?
  89.                     PRINT #1, a$;           ' Send it to modem
  90.             END SELECT                      '
  91.         END IF                              '
  92.     WEND                                    '
  93. LOOP                                        'End endless loop
  94.                                             '
  95. errorroutine:                               'Who knows what evil
  96. PRINT "Error type"; ERR; "occurred!"        'lurks within the
  97. RESUME NEXT                                 'hearts of computers?
  98.  
  99. SUB bottomline                              'Prints line 25
  100. PRINT #2, cs$;                              'Clear screen
  101. PRINT #2, es$ + "[25;1f";                   'LOCATE 25, 1
  102. PRINT #2, es$ + "[1;37;44m";                'Bright white on blue
  103. PRINT #2, "Z QB Dialer  Copr. 1990 by Charles Graham   ";
  104. PRINT #2, es$ + "[1;33m";                   'Yellow on blue
  105. PRINT #2, "  ESC Hang Up    F1 Dial    F10 End";
  106. PRINT #2, ao$;                              'Attributes off
  107. PRINT #2, hc$ + " " + hc$;                  'Home cursor
  108. END SUB                                     '
  109.  
  110. SUB delay                                   'Wastes time
  111. now! = TIMER                                '"now!" needs to be
  112. WHILE TIMER - now! < 1.5                    ' a SINGLE precision
  113. WEND                                        ' variable
  114. END SUB                                     '
  115.  
  116. SUB getparms                                'You need these
  117. PRINT #2, cs$;                              'Clear screen
  118. IF firsttime$ = "on" THEN                   'Skip this if it's
  119.     firsttime$ = "off"                      ' your first call;
  120. ELSE                                        ' otherwise:
  121.     PRINT #2, es$ + "[1;36m";               'Light cyan
  122.     PRINT #2, hc$;                          'Home cursor
  123.     PRINT #2, "Modem speed ";               'Prompt for bps
  124.     PRINT #2, es$ + "[1;33m";               'Yellow
  125.     PRINT #2, "3";                          '
  126.     PRINT #2, es$ + "[1;36m";               'Light cyan
  127.     PRINT #2, "00 ";                        '
  128.     PRINT #2, es$ + "[1;33m";               'Yellow
  129.     PRINT #2, "1";                          '
  130.     PRINT #2, es$ + "[1;36m";               'Light cyan
  131.     PRINT #2, "200 ";                       '
  132.     PRINT #2, es$ + "[1;33m";               'Yellow
  133.     PRINT #2, "2";                          '
  134.     PRINT #2, es$ + "[1;36m";               'Light cyan
  135.     PRINT #2, "400 ";                       '
  136.     PRINT #2, es$ + "[1;33m";               'Yellow
  137.     PRINT #2, "9";                          '
  138.     PRINT #2, es$ + "[1;36m";               'Light cyan
  139.     PRINT #2, "600 [";                      '
  140.     PRINT #2, es$ + "[1;33m";               'Yellow
  141.     PRINT #2, "1";                          '
  142.     PRINT #2, es$ + "[1;36m";               'Light cyan
  143.     PRINT #2, "/";                          '
  144.     PRINT #2, es$ + "[1;33m";               'Yellow
  145.     PRINT #2, "2";                          '
  146.     PRINT #2, es$ + "[1;36m";               'Light cyan
  147.     PRINT #2, "/";                          '
  148.     PRINT #2, es$ + "[1;33m";               'Yellow
  149.     PRINT #2, "3";                          '
  150.     PRI